;;;
;;; JaCoLiB
;;; Copyright (C) 2008 Alessandro Serra
;;; 
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;

;;;; Created on 2008-07-02 09:54:33

(in-package :jacolib)

;
; common lisp shell
;

(defclass cl-shell (shell)
  ()
  (:documentation "A common lisp shell."))

; variables

(defvar *cl-shell* (make-instance 'cl-shell))

; macros

(defmacro catch-shell-eval-error (code)
  `(handler-case
    ,code
    (end-of-file(x) 
      (error 'parser-error :message (format nil "~A" x)))
    (jacolib-error(x) (error x))
    (error(x) (error 'target-error :message (format nil "~A" x)))))

; methods

(defmethod shell-language-name ((shell cl-shell))
  "common-lisp")

(defmethod shell-get ((shell cl-shell) (key string))
    (catch-shell-eval-error
     (eval (get-key-symbol key))))

(defmethod shell-set ((shell cl-shell) (key string) obj)
  (catch-shell-eval-error
   (setf (symbol-value (get-key-symbol key)) obj))
  nil)

(defmethod shell-unset ((shell cl-shell) (key string))
  (catch-shell-eval-error
   (makunbound (get-key-symbol key)))
  nil)

(defmethod shell-eval ((shell cl-shell) (code string))
  (catch-shell-eval-error
   (shell-eval-form-from-string code 0)))

(defmethod shell-source ((shell cl-shell) (filename string))
  (catch-shell-eval-error
   (with-open-file (strm filename :direction :input)
		   (shell-eval-form-from-stream strm)))
  nil)


; eval-form functions

(defun shell-eval-form-from-string (text start)
  (declare (type string text)
           (integer start))
  (let ((response ""))
    (multiple-value-bind (form next)
      (read-from-string text nil 'eof :start start)
      (when (not (eql form 'eof))
        (let ((this-response (eval form)))
          (setf response this-response)
          (shell-eval-form-from-string text next)))
      response)))

(defun shell-eval-form-from-stream (strm)
  (declare (type stream strm))
  (let ((response "")
        (form (read strm)))
    (when (not (eql form 'eof))
      (let ((this-response (eval form)))
        (setf response this-response)
        (shell-eval-form-from-stream strm)))
    response))

; key symbol

(defun get-key-symbol (key)
  (let ((len (length key)))
    (multiple-value-bind (form next)
      (read-from-string key)
      (if (/= next len) 
          (error 'parser-error :message "Invalid symbol.")
          (if (symbolp form)
              form
              (error 'parser-error :message "Invalid symbol."))))))
